home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / GFXFX2.ZIP / 3D_LINE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  3KB  |  95 lines
  1.  
  2. program hidden; { 3D_LINE.PAS }
  3. { Hidden line routine - kinda buggy and schocky on most systems,
  4.   by Bas van Gaalen }
  5. uses u_vga,u_pal,u_3d,u_kb;
  6.  
  7. {$define cube} { deca, cube }
  8.  
  9. const
  10. {$ifdef deca}
  11.   fpoly=1; { first poly to draw from }
  12.   nofpoints=12; { number of points }
  13.   nofplanes=10; { number of planes }
  14.   points:array[1..nofpoints,0..2] of integer=(
  15.     (-20,-30, 20),( 20,-30, 20),( 40,  0, 40),(-40,  0, 40),
  16.     ( 20, 30, 20),(-20, 30, 20),(-20,-30,-20),( 20,-30,-20),
  17.     ( 40,  0,-40),(-40,  0,-40),( 20, 30,-20),(-20, 30,-20));
  18.   planes:array[1..nofplanes,0..3] of byte=(
  19.     (1,2,3,4),(4,3,5,6),(2,8,9,3),(3,9,11,5),(8,7,10,9),
  20.     (9,10,12,11),(7,1,4,10),(10,4,6,12),(7,8,2,1),(6,5,11,12));
  21. {$endif}
  22.  
  23. {$ifdef cube}
  24.   fpoly=4;
  25.   nofpoints=8;
  26.   nofplanes=6;
  27.   points:array[1..nofpoints,0..2] of integer=(
  28.     (-30,-30, 30),( 30,-30, 30),( 30, 30, 30),(-30, 30, 30),
  29.     (-30,-30,-30),( 30,-30,-30),( 30, 30,-30),(-30, 30,-30));
  30.   planes:array[1..nofplanes,0..3] of byte=(
  31.     (1,2,3,4),(2,6,7,3),(6,5,8,7),(5,1,4,8),(5,6,2,1),(4,3,7,8));
  32. {$endif}
  33.  
  34. var virscr:pointer;
  35.  
  36. procedure wireframe(x1,y1,x2,y2,x3,y3,x4,y4:word; c:byte);
  37. begin
  38.   vga_line(x1,y1,x2,y2,c);
  39.   vga_line(x2,y2,x3,y3,c);
  40.   vga_line(x3,y3,x4,y4,c);
  41.   vga_line(x4,y4,x1,y1,c);
  42. end;
  43.  
  44. procedure rotate_object;
  45. const xst=1; yst=1; zst=-2;
  46. var
  47.   xp,yp,z:array[1..nofpoints] of integer;
  48.   x,y:integer;
  49.   n,phix,phiy,phiz:byte;
  50. begin
  51.   phix:=0; phiy:=128; phiz:=0;
  52.   fillchar(xp,sizeof(xp),0);
  53.   fillchar(yp,sizeof(yp),0);
  54.   fillchar(z,sizeof(z),0);
  55.   destenation:=virscr;
  56.   repeat
  57.     setborder(200);
  58.     for n:=1 to nofpoints do begin
  59.       x:=points[n,0]; y:=points[n,1]; z[n]:=points[n,2];
  60.       rotate(x,y,z[n],phix,phiy,phiz);
  61.       conv3dto2d(xp[n],yp[n],x,y,z[n]);
  62.       inc(xp[n],160); inc(yp[n],100); { transfer object to middle of screen }
  63.     end;
  64.     for n:=1 to nofplanes do begin
  65.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  66.       pind[n]:=n;
  67.     end;
  68.     quicksort(nofplanes);
  69.     vretrace;
  70.     cls(destenation,320*200);
  71.     for n:=1 to nofplanes do
  72.       if not checkfront(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  73.                     xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  74.                     xp[planes[pind[n],2]],yp[planes[pind[n],2]]) then
  75.         wireframe(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  76.                   xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  77.                   xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  78.                   xp[planes[pind[n],3]],yp[planes[pind[n],3]],200);
  79.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  80.     setborder(0);
  81.     flip(virscr,vidptr,320*200);
  82.   until keypressed;
  83. end;
  84.  
  85. var i,j:word;
  86. begin
  87.   setvideo($13);
  88.   {u_border:=true;}
  89.   getmem(virscr,320*200); cls(virscr,320*200);
  90.   for i:=1 to 255 do setrgb(i,i div 16,i div 8,i div 4);
  91.   rotate_object;
  92.   freemem(virscr,320*200);
  93.   setvideo(u_lm);
  94. end.
  95.